DateCheck Subroutine

private subroutine DateCheck(time)

check that date do not contain errors.

Arguments

Type IntentOptional Attributes Name
type(DateTime), intent(in) :: time

Variables

Type Visibility Attributes Name Initial
character(len=timeStringLength), public :: string

Source Code

SUBROUTINE  DateCheck &
!
( time )

IMPLICIT NONE

! Arguments with intent(in):
TYPE (DateTime), INTENT(IN) :: time

! Local variables:
CHARACTER (LEN = timeStringLength) :: string
!------------end of declaration------------------------------------------------

IF (DateTimeIsDefault(time)) THEN
  RETURN !skip check
END IF

IF ( time % second < 0 .OR. time % second >= 60 ) THEN
   string = time
   CALL Catch ('error', 'Chronos', 'second ', &
               code = DateTimeError, argument = string )
END IF

IF ( time % minute < 0 .OR. time % minute >= 60 ) THEN
   string = time
   CALL Catch ('error', 'Chronos', 'minute ', &
               code = DateTimeError, argument = string )
END IF

IF ( time % hour < 0 .OR. time % hour >= 25 )  THEN
   string = time
   CALL Catch ('error', 'Chronos', 'hour ', &
               code = DateTimeError, argument = string )
END IF

IF ( time % year <= 0)  THEN
   string = time
   CALL Catch ('error', 'Chronos', 'year ', &
               code = DateTimeError, argument = string )
END IF

IF ( time % month <= 0 .OR. time % month > 12 )       THEN
   string = time
   CALL Catch ('error', 'Chronos', 'month ', &
               code = DateTimeError, argument = string )
ELSE IF ( time % day <= 0 .OR. time % day > &
         DaysInMonth (time % month, time % year)     ) THEN
   string = time      
   CALL Catch ('error', 'Chronos', 'day ', &
               code = DateTimeError, argument = string )
END IF
END SUBROUTINE DateCheck